home *** CD-ROM | disk | FTP | other *** search
AMOS Source Code | 1996-01-26 | 2.7 KB | 75 lines |
- ' AMOSPro
- '
- ' ********************************************************
- ' *** ***
- ' *** Copy Bob Procedure ***
- ' *** ***
- ' *** by ***
- ' *** ***
- ' *** Joseph Bolin ***
- ' *** ***
- ' ********************************************************
-
- Screen Open 0,320,200,4,Lowres
- Palette $0,$F00,$80
- Curs Off : Cls 2 : Ink 1 : Circle 8,8,7 : Paint 8,8
- Get Icon 1,0,0 To 17,17
- Cls 0
- _COPYBOB[-1,2]
- Paste Icon 16,16,1
- Paste Bob 64,64,2
-
- Procedure _COPYBOB[_SRCBOB,_DESTBOB]
-
- ' Inputs: _SRCBOB =Source image --- negative numbers signify icons
- ' _DESTBOB=Destination image --- negative numbers signify icons
- '
- ' Output: Copys one bob to another, including mask.
- ' There must either be a screen open with as many colors as the
- ' source bob and at least as large as it, or there must be an
- ' unopened screen.
- ' You may copy from a bob to an icon or from an icon to a bob
-
- If _SRCBOB>=0 Then SRCBASE=Sprite Base(_SRCBOB) Else SRCBASE=Icon Base(-_SRCBOB)
- If SRCBASE=0 Then Error 68
- If _SRCBOB>=0 Then SRCMASK=Sprite Base(-_SRCBOB) Else SRCMASK=Icon Base(_SRCBOB)
- SCR=Screen : BT=1 : PLN=Deek(SRCBASE+4)
- For T=1 To PLN
- BT=BT*2
- Next
- XS=Deek(SRCBASE)*16 : YS=Deek(SRCBASE+2)
- For SC=0 To 7
- Trap Screen SC
- If Errtrap=0 Then If Screen Colour=BT and Screen Width>=XS and Screen Height>=YS Then Exit
- Next
- If SC>7
- FLAG=1
- For SC=0 To 7
- Trap Screen SC : If Errtrap<>0 : Screen Open SC,Min(32,XS),Min(32,YS),BT,Lowres : Screen Hide : Exit : End If
- Next
- If SC=8 : Error 47 : End If : Rem *** no screens usable! ***
- End If
- Screen SC
- If _DESTBOB>0
- Get Bob _DESTBOB,0,0 To XS,YS
- If SRCMASK>0 : Paste Bob 0,0,_DESTBOB : End If
- End If
- If _DESTBOB<0
- Get Icon -_DESTBOB,0,0 To XS,YS
- If SRCMASK>0 : Paste Icon 0,0,_DESTBOB : End If
- End If
- If _DESTBOB>0 Then DESTBASE=Sprite Base(_DESTBOB) Else DESTBASE=Icon Base(-_DESTBOB)
- If _DESTBOB>0 Then DESTMASK=Sprite Base(-_DESTBOB) Else DESTMASK=Icon Base(_DESTBOB)
- SIZE=Deek(SRCBASE)*2*Deek(SRCBASE+2)*Deek(SRCBASE+4)
- Copy SRCBASE+6,SRCBASE+10+SIZE To DESTBASE+6
- If SRCMASK<0
- If _DESTBOB>0
- No Mask _DESTBOB
- Else
- No Icon Mask -_DESTBOB
- End If
- Pop Proc
- End If
- If SRCMASK>0 Then Copy SRCMASK,SRCMASK+SIZE/Deek(SRCBASE+4)+4 To DESTMASK
- Screen SCR : If FLAG Then Screen Close SC
- End Proc[0]